VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "clsMqWrap"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit
Private rsTemp As ADODB.Recordset
Private objMqSeries As clsMqSeries
Public Server_Name As String
Public Function MQPUT(ByVal Requestkey As String, ByVal Data As String, _
    Optional ByVal MsgLen As Long, Optional ByRef MsgID As String, _
    Optional ByRef CorrelID As String, _
    Optional ByRef DateTime As String) As Long
'Purpose
'*******
'this function makes a connection to the specified queue manager, opens the queue and
'puts a mesages in the queue
'If successful, 0 is returned else a error code is returned.

'Variables
'*********

Dim RetCode As Long
Dim sMsgId As String
Dim sCorrelId As String
Dim sDateTime As String
Dim lMsgLen As Long
Dim strSQL As String
Dim QMgr As String


'Code
'****
    On Error GoTo MQPutFix
GetdbData:

    
    Set objMqSeries = New clsMqSeries
    
'*******************************
'Get Queue Manager Name for PUT
'*******************************

     strSQL = "select ODOBJECTQMGRNAME from MqProp where upper(actiontype) = 'PUT' and upper(RequestKey) = '" & _
        UCase(Trim(Requestkey)) & "'"
    Set rsTemp = Get_Recordset(strSQL, Server_Name)
    If Not rsTemp.EOF Then
        If Not IsNull(rsTemp("ODOBJECTQMGRNAME")) Then
            QMgr = rsTemp("ODOBJECTQMGRNAME")
        End If
    End If

'******************************
'*
'* This might change as only one queue has to be opened every time
'* QMgr would be only one queue every time
'*
'******************************
    
    sMsgId = ""
    sCorrelId = ""
    
'*
'Open Queue Manager
'Step 1 Put
    RetCode = objMqSeries.MQ_Op_Conn(QMgr)
    
    If RetCode = 2002 Then
        'already connected
    ElseIf RetCode <> 0 Then
        MQPUT = RetCode
        Set objMqSeries = Nothing
        Exit Function
    End If
    
'*
'Open PUT Queue
'Step 2 Put
    RetCode = objMqSeries.MQ_Put_Open(Requestkey)
    If RetCode <> 0 Then
        GoTo CloseConAndExist
    End If
    
    lMsgLen = 0 'use msglen if specified
    If Not IsMissing(MsgLen) Then
        lMsgLen = MsgLen
    End If
    
'*
'PUT the message on the Queue
'Step 3 Put
    RetCode = objMqSeries.MQ_Put_Msg(Requestkey, Data, sCorrelId, sMsgId, sDateTime, lMsgLen)
    If RetCode <> 0 Then
        GoTo CloseConAndExist
    End If
    If Not IsMissing(DateTime) Then 'return put date time if speciied
        DateTime = sDateTime
    End If
    If Not IsMissing(MsgID) Then 'return msgid if specified
        MsgID = sMsgId
    End If
    If Not IsMissing(CorrelID) Then 'return correlid if specified
        CorrelID = sCorrelId
    End If
'Close Connection
'Step 4 Put
    RetCode = objMqSeries.MQ_Close_Conn 'close the connection
     If RetCode <> 0 Then
CloseConAndExist:
        MQPUT = RetCode
        Set objMqSeries = Nothing
        Exit Function
    End If
    
'deallocate
'**********
    'Set objMqSeries = Nothing
    
    Exit Function
MQPutFix:
    If Err.Number = 91 Then
        'the dataconnection could be lost
        'If objMqGlobal.Database_Re_Connect Then
        '    GoTo GetdbData
    'Else
            App.LogEvent "Mq could not connect to the database. clsMqSeries.MQPut"
        'End If
    Else
        App.LogEvent Err.Description & " clsMqSeries.MQPut"
    End If
End Function
Public Function MQGET(ByVal Requestkey As String, ByVal GetOption As String, _
                ByRef Data As String, Optional ByRef MsgID As String, _
                Optional ByRef CorrelID As String) As Long
'Purpose
'*******
'This function makes a connection to the queue manager opens the queue and gets a message.

'Variables
'*********
    Dim RetCode As Long
    Dim sMsgId As String
    Dim sCorrelId As String
    Dim QMgr As String
    Dim QName As String
    Dim strSQL As String
    
'Code
'****
    On Error GoTo MQGetFix
    
    Set objMqSeries = New clsMqSeries
    
    sMsgId = ""
    If Not IsMissing(MsgID) Then
        sMsgId = MsgID
    End If
    sCorrelId = ""
    If Not IsMissing(CorrelID) Then
        sCorrelId = CorrelID
    End If
    
DBMqGet:


    strSQL = "select ODOBJECTQMGRNAME from MqProp where upper(actiontype) = 'GET' and upper(RequestKey) = '" & _
        UCase(Trim(Requestkey)) & "'"
   
    Set rsTemp = Get_Recordset(strSQL, Server_Name)
    If Not rsTemp.EOF Then
        If Not IsNull(rsTemp("ODOBJECTQMGRNAME")) Then
            QMgr = rsTemp("ODOBJECTQMGRNAME")
        End If
    End If
 'Open Get Q Manager
 'Step 1 Get
    RetCode = objMqSeries.MQ_Op_Conn(QMgr)  '("LMD1UMMS")
    If RetCode = 2002 Then
        'already connected
    ElseIf RetCode <> 0 Then
        MQGET = RetCode
        Set objMqSeries = Nothing
        Exit Function
    End If
'Open Get Queue
'Step 2 Get
    RetCode = objMqSeries.MQ_Get_Open(GetOption, Requestkey)
    If RetCode <> 0 Then
        GoTo CloseConAndExist
    End If
'Get Data from Queue
'Step 3 Get
    RetCode = objMqSeries.MQ_Get_Msg(Data, Requestkey, sCorrelId, sMsgId, GetOption)
    
    If RetCode <> 0 Then
        GoTo CloseConAndExist
    End If
    If Not IsMissing(MsgID) Then
        MsgID = sMsgId
    End If
    sCorrelId = ""
    If Not IsMissing(CorrelID) Then
        CorrelID = sCorrelId
    End If
    
'Step 4 Close Connection
    RetCode = objMqSeries.MQ_Close_Conn
    
     If RetCode <> 0 Then
CloseConAndExist:
        MQGET = RetCode
        RetCode = objMqSeries.MQ_Close_Conn
        Set objMqSeries = Nothing
        Exit Function
    End If
    
'deallocate
'**********
    Set objMqSeries = Nothing
    
    Exit Function
    
MQGetFix:
    If Err.Number = 91 Then
        'the dataconnection could be lost
        'If objMqGlobal.Database_Re_Connect Then
        '    GoTo DBMqGet
        'Else
            App.LogEvent "Mq could not connect to the database. clsMqSeries.MQPut"
        'End If
    Else
        App.LogEvent Err.Description & " clsMqSeries.MQGet"
    End If
End Function

Public Function GetErrMessage(ByVal ErrCode As Long) As String
'purpose
'*******
'This function returns mq error messages for the mq err code specified

'variables
'*********
Dim strSQL As String

'Code
'****
    On Error GoTo GetErrMessageFix
    
    Set objMqSeries = New clsMqSeries
    
DBGetErr:
    GetErrMessage = "Error code (" & ErrCode & ") is not defined"
    
    strSQL = "select ERRORMSG from MqErr where errorcode = " & ErrCode
    Set rsTemp = Get_Recordset(strSQL, Server_Name)
    If Not rsTemp.EOF Then
        If Not IsNull(rsTemp("ERRORMSG")) Then
            GetErrMessage = rsTemp("ERRORMSG")
        End If
    End If
    
    
'Deallocate
'**********
    Set objMqSeries = Nothing
    Exit Function
    
GetErrMessageFix:
    If Err.Number = 91 Then
        'the dataconnection could be lost
        'If objMqGlobal.Database_Re_Connect Then
        '    GoTo DBGetErr
        'Else
        App.LogEvent "Mq could not connect to the database. clsMqSeries.MQPut"
        'End If
    Else
        App.LogEvent Err.Description & " clsMqSeries.GetErrMessage"
        'Set objMqSeries = Nothing
    End If
End Function

Public Sub UpdateAuditTableOnce(ByVal PutRequestKey As String, _
    ByVal PutDateTime As Date, ByVal PutErrCode As Long, _
    ByVal GetRequestKey As String, ByVal GetDateTime As Date, _
    ByVal GetErrCode As Long)
'Purpose
'*******
'This function updates the MqAudit table
'The MQIndex field is returned -(this is the record number)that was updated/inserted

'Variables
'*********

Dim strSQL As String
Dim NewIndex As Double
Dim SetSql As String
Dim WhereSql As String
Dim PutStoreErr As Double
Dim GetStoreErr As Double
Dim PutQManager As String
Dim GetQManager As String
Dim PutQName As String
Dim GetQName As String
Dim UserName As String * 25
Dim ret As Long
Dim SaveUser As String
Dim i As Integer
Dim rsMqAudit As ADODB.Recordset

'Code
'****
    On Error GoTo UpdateAuditTableFix
    
dbUpdateAudit:
    strSQL = "select ODOBJECTQMGRNAME,ODOBJECTNAME,ActionType,RequestKey from MqProp where "
    strSQL = strSQL & " (upper(actiontype) = 'GET' or upper(actiontype) = 'PUT') and (upper(RequestKey) = '" _
            & UCase(Trim("FILENETTOMDP")) & "' or upper(RequestKey) = '" & UCase(Trim("MDPTOFILENET")) & "')"
            
            
    Set rsTemp = Get_Recordset(strSQL, Server_Name)
    
    While Not rsTemp.EOF
        If UCase(rsTemp("ActionType")) = "GET" And UCase(rsTemp("RequestKey")) = UCase("MDPTOFILENET") Then
            GetQManager = rsTemp("ODOBJECTQMGRNAME")
            GetQName = rsTemp("ODOBJECTNAME")
        ElseIf UCase(rsTemp("ActionType")) = "PUT" And UCase(rsTemp("RequestKey")) = UCase("FILENETTOMDP") Then
            PutQManager = rsTemp("ODOBJECTQMGRNAME")
            PutQName = rsTemp("ODOBJECTNAME")
        End If
        rsTemp.MoveNext
    Wend
        
    ret = GetUserName(UserName, 25)
    SaveUser = ""
    For i = 1 To Len(UserName)
        If Asc(Mid(UserName, i, 1)) = 0 Then
            SaveUser = SaveUser & " "
        Else
            SaveUser = SaveUser & Mid(UserName, i, 1)
        End If
    Next i
    
    PutStoreErr = PutErrCode
    GetStoreErr = GetErrCode
    
    '>BARB
    Set rsMqAudit = Get_Recordset("SELECT MAX(MQINDEX) FROM MQAUDIT", Server_Name)
    NewIndex = rsMqAudit(0) + 1
    '>BARB
    
    'Insert new record
    strSQL = "insert into MqAudit values(" & NewIndex & ",'" & PutQManager & "','" & PutQName & "','" & "FILENETTOMDP" & "','" & GetQManager & "','" & GetQName & "',"
    strSQL = strSQL & " to_date('" & Format(PutDateTime, "DD-MMM-YYYY HH:NN") & "','DD-MON-YYYY HH24:MI'),"
    strSQL = strSQL & " to_date('" & Format(GetDateTime, "DD-MMM-YYYY HH:NN") & "','DD-MON-YYYY HH24:MI'),"
    strSQL = strSQL & "'" & Trim(SaveUser) & "','" & Trim(SaveUser) & "'," & PutStoreErr & "," & GetStoreErr & ")"
    
    Get_Recordset strSQL, Server_Name
    
'Deallocate
'**********
   
    
    Exit Sub
    
UpdateAuditTableFix:
    If Err.Number = 91 Then
    '    'the dataconnection could be lost
    '    If objMqGlobal.Database_Re_Connect Then
    '        GoTo dbUpdateAudit
    '   Else
    App.LogEvent "Mq could not connect to the database. clsMqSeries.MQPut"
    '    End If
    Else
    App.LogEvent Err.Description & " clsMqSeries.UpdateAuditTableOnce"
    End If
End Sub

Private Sub Class_Initialize()
    
'    Dim blnConnect As Boolean
'
'    Set objMqAdoConn = CreateObject("AdoDbserver.clsAdoConnection")
'    objMqAdoConn.ReturnErrMsg = False
'    blnConnect = objMqAdoConn.InitConnect '"idb", "udd", "udd"              ' , "SA"
'     If Not blnConnect Then
'            MsgBox "Cound not establish a connection to the database.", vbOKOnly + vbCritical
'            'End 'can't use end in dll
'    End If
'Setup server
'************
Dim GetDatabaseName As Object
Set GetDatabaseName = CreateObject("MQCall.clsReg")

Server_Name = GetDatabaseName.MQDatabaseName
    
End Sub

Private Sub Class_Terminate()
    'terminate the mq connection regardless, DONE!
    If Not (objMqSeries Is Nothing) Then
        objMqSeries.MQ_Close_Conn
        Set objMqSeries = Nothing
    End If
        
'    Set objMqAdoConn = Nothing
End Sub
